<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
 <head>
  <title>slacn2.f</title>
 <meta name="generator" content="emacs 21.3.1; htmlfontify 0.20">
<style type="text/css"><!-- 
body { background: rgb(255, 255, 255);  color: rgb(0, 0, 0);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.default   { background: rgb(255, 255, 255);  color: rgb(0, 0, 0);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.default a { background: rgb(255, 255, 255);  color: rgb(0, 0, 0);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: underline; }
span.comment   { color: rgb(178, 34, 34);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.comment a { color: rgb(178, 34, 34);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: underline; }
 --></style>

 </head>
  <body>

<pre>
      SUBROUTINE <a name="SLACN2.1"></a><a href="slacn2.f.html#SLACN2.1">SLACN2</a>( N, V, X, ISGN, EST, KASE, ISAVE )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  -- LAPACK auxiliary routine (version 3.1) --
</span><span class="comment">*</span><span class="comment">     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
</span><span class="comment">*</span><span class="comment">     November 2006
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     .. Scalar Arguments ..
</span>      INTEGER            KASE, N
      REAL               EST
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Array Arguments ..
</span>      INTEGER            ISGN( * ), ISAVE( 3 )
      REAL               V( * ), X( * )
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Purpose
</span><span class="comment">*</span><span class="comment">  =======
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  <a name="SLACN2.19"></a><a href="slacn2.f.html#SLACN2.1">SLACN2</a> estimates the 1-norm of a square, real matrix A.
</span><span class="comment">*</span><span class="comment">  Reverse communication is used for evaluating matrix-vector products.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Arguments
</span><span class="comment">*</span><span class="comment">  =========
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  N      (input) INTEGER
</span><span class="comment">*</span><span class="comment">         The order of the matrix.  N &gt;= 1.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  V      (workspace) REAL array, dimension (N)
</span><span class="comment">*</span><span class="comment">         On the final return, V = A*W,  where  EST = norm(V)/norm(W)
</span><span class="comment">*</span><span class="comment">         (W is not returned).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  X      (input/output) REAL array, dimension (N)
</span><span class="comment">*</span><span class="comment">         On an intermediate return, X should be overwritten by
</span><span class="comment">*</span><span class="comment">               A * X,   if KASE=1,
</span><span class="comment">*</span><span class="comment">               A' * X,  if KASE=2,
</span><span class="comment">*</span><span class="comment">         and <a name="SLACN2.36"></a><a href="slacn2.f.html#SLACN2.1">SLACN2</a> must be re-called with all the other parameters
</span><span class="comment">*</span><span class="comment">         unchanged.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  ISGN   (workspace) INTEGER array, dimension (N)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  EST    (input/output) REAL
</span><span class="comment">*</span><span class="comment">         On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be
</span><span class="comment">*</span><span class="comment">         unchanged from the previous call to <a name="SLACN2.43"></a><a href="slacn2.f.html#SLACN2.1">SLACN2</a>.
</span><span class="comment">*</span><span class="comment">         On exit, EST is an estimate (a lower bound) for norm(A). 
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  KASE   (input/output) INTEGER
</span><span class="comment">*</span><span class="comment">         On the initial call to <a name="SLACN2.47"></a><a href="slacn2.f.html#SLACN2.1">SLACN2</a>, KASE should be 0.
</span><span class="comment">*</span><span class="comment">         On an intermediate return, KASE will be 1 or 2, indicating
</span><span class="comment">*</span><span class="comment">         whether X should be overwritten by A * X  or A' * X.
</span><span class="comment">*</span><span class="comment">         On the final return from <a name="SLACN2.50"></a><a href="slacn2.f.html#SLACN2.1">SLACN2</a>, KASE will again be 0.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  ISAVE  (input/output) INTEGER array, dimension (3)
</span><span class="comment">*</span><span class="comment">         ISAVE is used to save variables between calls to <a name="SLACN2.53"></a><a href="slacn2.f.html#SLACN2.1">SLACN2</a>
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Further Details
</span><span class="comment">*</span><span class="comment">  ======= =======
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Contributed by Nick Higham, University of Manchester.
</span><span class="comment">*</span><span class="comment">  Originally named SONEST, dated March 16, 1988.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Reference: N.J. Higham, &quot;FORTRAN codes for estimating the one-norm of
</span><span class="comment">*</span><span class="comment">  a real or complex matrix, with applications to condition estimation&quot;,
</span><span class="comment">*</span><span class="comment">  ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  This is a thread safe version of <a name="SLACON.65"></a><a href="slacon.f.html#SLACON.1">SLACON</a>, which uses the array ISAVE
</span><span class="comment">*</span><span class="comment">  in place of a SAVE statement, as follows:
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     <a name="SLACON.68"></a><a href="slacon.f.html#SLACON.1">SLACON</a>     <a name="SLACN2.68"></a><a href="slacn2.f.html#SLACN2.1">SLACN2</a>
</span><span class="comment">*</span><span class="comment">      JUMP     ISAVE(1)
</span><span class="comment">*</span><span class="comment">      J        ISAVE(2)
</span><span class="comment">*</span><span class="comment">      ITER     ISAVE(3)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  =====================================================================
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     .. Parameters ..
</span>      INTEGER            ITMAX
      PARAMETER          ( ITMAX = 5 )
      REAL               ZERO, ONE, TWO
      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 )
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Local Scalars ..
</span>      INTEGER            I, JLAST
      REAL               ALTSGN, ESTOLD, TEMP
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. External Functions ..
</span>      INTEGER            ISAMAX
      REAL               SASUM
      EXTERNAL           ISAMAX, SASUM
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. External Subroutines ..
</span>      EXTERNAL           SCOPY
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Intrinsic Functions ..
</span>      INTRINSIC          ABS, NINT, REAL, SIGN
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Executable Statements ..
</span><span class="comment">*</span><span class="comment">
</span>      IF( KASE.EQ.0 ) THEN
         DO 10 I = 1, N
            X( I ) = ONE / REAL( N )
   10    CONTINUE
         KASE = 1
         ISAVE( 1 ) = 1
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      GO TO ( 20, 40, 70, 110, 140 )ISAVE( 1 )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ................ ENTRY   (ISAVE( 1 ) = 1)
</span><span class="comment">*</span><span class="comment">     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY A*X.
</span><span class="comment">*</span><span class="comment">
</span>   20 CONTINUE
      IF( N.EQ.1 ) THEN
         V( 1 ) = X( 1 )
         EST = ABS( V( 1 ) )
<span class="comment">*</span><span class="comment">        ... QUIT
</span>         GO TO 150
      END IF
      EST = SASUM( N, X, 1 )
<span class="comment">*</span><span class="comment">
</span>      DO 30 I = 1, N
         X( I ) = SIGN( ONE, X( I ) )
         ISGN( I ) = NINT( X( I ) )
   30 CONTINUE
      KASE = 2
      ISAVE( 1 ) = 2
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ................ ENTRY   (ISAVE( 1 ) = 2)
</span><span class="comment">*</span><span class="comment">     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
</span><span class="comment">*</span><span class="comment">
</span>   40 CONTINUE
      ISAVE( 2 ) = ISAMAX( N, X, 1 )
      ISAVE( 3 ) = 2
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
</span><span class="comment">*</span><span class="comment">
</span>   50 CONTINUE
      DO 60 I = 1, N
         X( I ) = ZERO
   60 CONTINUE
      X( ISAVE( 2 ) ) = ONE
      KASE = 1
      ISAVE( 1 ) = 3
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ................ ENTRY   (ISAVE( 1 ) = 3)
</span><span class="comment">*</span><span class="comment">     X HAS BEEN OVERWRITTEN BY A*X.
</span><span class="comment">*</span><span class="comment">
</span>   70 CONTINUE
      CALL SCOPY( N, X, 1, V, 1 )
      ESTOLD = EST
      EST = SASUM( N, V, 1 )
      DO 80 I = 1, N
         IF( NINT( SIGN( ONE, X( I ) ) ).NE.ISGN( I ) )
     $      GO TO 90
   80 CONTINUE
<span class="comment">*</span><span class="comment">     REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
</span>      GO TO 120
<span class="comment">*</span><span class="comment">
</span>   90 CONTINUE
<span class="comment">*</span><span class="comment">     TEST FOR CYCLING.
</span>      IF( EST.LE.ESTOLD )
     $   GO TO 120
<span class="comment">*</span><span class="comment">
</span>      DO 100 I = 1, N
         X( I ) = SIGN( ONE, X( I ) )
         ISGN( I ) = NINT( X( I ) )
  100 CONTINUE
      KASE = 2
      ISAVE( 1 ) = 4
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ................ ENTRY   (ISAVE( 1 ) = 4)
</span><span class="comment">*</span><span class="comment">     X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
</span><span class="comment">*</span><span class="comment">
</span>  110 CONTINUE
      JLAST = ISAVE( 2 )
      ISAVE( 2 ) = ISAMAX( N, X, 1 )
      IF( ( X( JLAST ).NE.ABS( X( ISAVE( 2 ) ) ) ) .AND.
     $    ( ISAVE( 3 ).LT.ITMAX ) ) THEN
         ISAVE( 3 ) = ISAVE( 3 ) + 1
         GO TO 50
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ITERATION COMPLETE.  FINAL STAGE.
</span><span class="comment">*</span><span class="comment">
</span>  120 CONTINUE
      ALTSGN = ONE
      DO 130 I = 1, N
         X( I ) = ALTSGN*( ONE+REAL( I-1 ) / REAL( N-1 ) )
         ALTSGN = -ALTSGN
  130 CONTINUE
      KASE = 1
      ISAVE( 1 ) = 5
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ................ ENTRY   (ISAVE( 1 ) = 5)
</span><span class="comment">*</span><span class="comment">     X HAS BEEN OVERWRITTEN BY A*X.
</span><span class="comment">*</span><span class="comment">
</span>  140 CONTINUE
      TEMP = TWO*( SASUM( N, X, 1 ) / REAL( 3*N ) )
      IF( TEMP.GT.EST ) THEN
         CALL SCOPY( N, X, 1, V, 1 )
         EST = TEMP
      END IF
<span class="comment">*</span><span class="comment">
</span>  150 CONTINUE
      KASE = 0
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="SLACN2.212"></a><a href="slacn2.f.html#SLACN2.1">SLACN2</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>
